home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue45 / DCOM / DCOMSec / DCOMSecUtils.pas
Encoding:
Pascal/Delphi Source File  |  1999-12-06  |  4.6 KB  |  155 lines
  1. unit DCOMSecUtils;
  2.  
  3. interface
  4. uses Windows,ActiveX;
  5. const
  6.   IID_IAccessControl  : TGUID = '{EEDD23E0-8410-11CE-A1C3-08002B2B8D8F}';
  7.  
  8.   RPC_C_AUTHN_NONE         = 0;
  9.   RPC_C_AUTHN_DCE_PRIVATE  = 1;
  10.   RPC_C_AUTHN_DCE_PUBLIC   = 2;
  11.   RPC_C_AUTHN_DEC_PUBLIC   = 4;
  12.   RPC_C_AUTHN_WINNT        = 10;
  13.   RPC_C_AUTHN_DEFAULT      = $FFFFFFFF;
  14.  
  15.   RPC_C_AUTHN_LEVEL_DEFAULT       = 0;
  16.   RPC_C_AUTHN_LEVEL_NONE          = 1;
  17.   RPC_C_AUTHN_LEVEL_CONNECT       = 2;
  18.   RPC_C_AUTHN_LEVEL_CALL          = 3;
  19.   RPC_C_AUTHN_LEVEL_PKT           = 4;
  20.   RPC_C_AUTHN_LEVEL_PKT_INTEGRITY = 5;
  21.   RPC_C_AUTHN_LEVEL_PKT_PRIVACY   = 6;
  22.  
  23.   RPC_C_AUTHZ_NONE = 0;
  24.   RPC_C_AUTHZ_NAME = 1;
  25.   RPC_C_AUTHZ_DCE  = 2;
  26.  
  27.   RPC_C_IMP_LEVEL_ANONYMOUS    = 1;
  28.   RPC_C_IMP_LEVEL_IDENTIFY     = 2;
  29.   RPC_C_IMP_LEVEL_IMPERSONATE  = 3;
  30.   RPC_C_IMP_LEVEL_DELEGATE     = 4;
  31.  
  32.     EOAC_NONE                    = $0;
  33.     EOAC_DEFAULT                 = $800;
  34.     EOAC_MUTUAL_AUTH             = $1;
  35.     EOAC_STATIC_CLOAKING         = $20;
  36.     EOAC_DYNAMIC_CLOAKING        = $40;
  37.     EOAC_ANY_AUTHORITY           = $80;
  38. // These are only valid for CoInitializeSecurity
  39.     EOAC_SECURE_REFS             = $2;
  40.     EOAC_ACCESS_CONTROL          = $4;
  41.     EOAC_APPID                   = $8;
  42.     EOAC_MAKE_FULLSIC            = $100;
  43.     EOAC_REQUIRE_FULLSIC         = $200;
  44.     EOAC_AUTO_IMPERSONATE        = $400;
  45.     SEC_WINNT_AUTH_IDENTITY_ANSI    = $1;
  46.     SEC_WINNT_AUTH_IDENTITY_UNICODE = $2;
  47.  
  48.  
  49. type
  50.   PCOAUTHIDENTITY  = ^TCOAUTHIDENTITY;
  51.   PShort           = ^Short;
  52.  
  53.   TCOAUTHIDENTITY  = record
  54.     User           : PShort; //UserName
  55.     UserLength     : ULONG;
  56.     Domain         : PShort; //DomainName
  57.     DomainLength   : ULONG;
  58.     Password       : PShort; //Password
  59.     PasswordLength : ULONG;
  60.     Flags         : ULONG;
  61.   end;
  62.  
  63.  TCoAuthInfo = record
  64.     dwAuthnSvc           : DWORD;
  65.     dwAuthzSvc           : DWORD;
  66.     pwszServerPrincName  : LPWSTR;
  67.     dwAuthnLevel         : DWORD ;
  68.     dwImpersonationLevel : DWORD ;
  69.     pAuthIdentityData    : PCOAUTHIDENTITY;
  70.     dwCapabilities       : DWORD;
  71.     end;
  72.  
  73.   IServerSecurity =  interface(IUnknown)
  74.     ['{0000013E-0000-0000-C000-000000000046}']
  75.  
  76.     function QueryBlanket
  77.     (
  78.         out AuthnSvc :DWORD;
  79.         out AuthzSvc :DWORD;
  80.         out ServerPrincName: POleStr;
  81.         out AuthnLevel   :DWORD;
  82.         out ImpLevel     : DWORD;
  83.         out Privs         : Pointer;
  84.         out Capabilities  : DWORD
  85.     ) :HResult; stdcall;
  86.      function ImpersonateClient :HResult; stdcall;
  87.      function RevertToSelf :HResult; stdcall;
  88.      function IsImpersonating :BOOL; stdcall;
  89.     end;
  90.  
  91.  
  92. procedure  SwitchSecurityOff(Authnlevel : boolean);
  93. function  ClientBlanketInfo : string;
  94.  
  95. // CoQueryClientBlanket was incorrectly defined !!!
  96. function CoQueryClientBlanket(var pwAuthnSvc, pAuthzSvc: Longint;
  97.   var pServerPrincName: POleStr; var dwAuthnLevel, dwImpLevel: Longint;
  98.    var pPrivs: Pointer; var dwCapabilites: Longint): HResult; stdcall;
  99.  
  100. implementation
  101.  
  102. uses Sysutils,ComObj;
  103. const
  104.   ole32    = 'ole32.dll';
  105.   
  106. function CoQueryClientBlanket;          external ole32 name 'CoQueryClientBlanket';
  107.  
  108. function  ClientBlanketInfo : string;
  109. var
  110.   P : PWideChar;
  111.   ServerPrincName : PWidechar;
  112.   PrincipalName : string;
  113.   ClientName : string;
  114.   AuthnSvc, AuthzSvc,Capabilit: Longint;
  115.   AuthnLevel, ImpLevel: Longint;
  116.   
  117. begin
  118.   p := nil;
  119.   Capabilit := EOAC_NONE;
  120.   ServerPrincName := nil;
  121.   OLECheck(CoQueryClientBlanket(AuthnSvc, AuthzSvc,
  122.          ServerPrincName, AuthnLevel, ImpLevel,  Pointer(P), Capabilit));
  123.   ClientName    := '';
  124.   PrincipalName := '';
  125.  
  126.   if p <> nil then
  127.      ClientName := WideCharToString(PWideChar(P));
  128.  
  129.   if ServerPrincName <> nil then
  130.    begin
  131.     PrincipalName := WideCharToString(ServerPrincName);
  132.     CoTaskMemFree(ServerPrincName);
  133.    end;
  134.   Result := Format(' %s %s ',[PrincipalName, ClientName]);
  135. end;
  136.  
  137. procedure  SwitchSecurityOff(AuthnLevel : boolean);
  138. const
  139.  AuthenticationLevel : array [boolean] of integer =
  140.                     (RPC_C_AUTHN_LEVEL_NONE, RPC_C_AUTHN_LEVEL_CONNECT);
  141. begin
  142.   //if the authentication level is set to connect then the DCOM RPC will try to
  143.   //make sure the user is part of the domain, so we really only want NONE
  144.   //DCOM client, we need to call this before CCIEx
  145.   //DCOM server, we need to call this before ClassFactory is instantiated
  146.   OleCheck(CoInitializeSecurity(nil,-1,nil,nil,
  147.                                AuthenticationLevel[AuthnLevel],
  148.                                RPC_C_IMP_LEVEL_IMPERSONATE,nil,EOAC_NONE,nil));
  149.  
  150. end;
  151.  
  152.  
  153.  
  154. end.
  155.